AMHLSW.m

AMHLSW ; IHS/CMI/LAB - SWITCH TO V FILE ;

 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 ;

 ; AMHLSWD=DICTIONARY NUMBER

 ; AMHLSWCR=LINKING CROSS REFERENCE

 ; AMHLSWV=VISIT DFN

 ;

 S U="^"

 S AMHLOOK=""

 Q:'$D(AMHSWV)

 Q:AMHSWV=""

 Q:'$D(AMHSWD)

 Q:'AMHSWD

 Q:'$D(^DIC(AMHSWD,0,"GL"))

 S AMHSWG=^DIC(AMHSWD,0,"GL")

 I '$D(AMHSWCR),AMHSWD'=(AMHSWD\1),AMHSWD\1=9000010 S AMHSWCR="AD"

 I '$D(AMHSWCR),AMHSWD\1'=9000010 S AMHSWCR="AC"

 Q:'$D(AMHSWCR)

 Q:AMHSWCR=""

 W !

 S AMHSWDA=0 F AMHSWI=1:1 S AMHSWDA=$O(@(AMHSWG_""""_AMHSWCR_""",AMHSWV,AMHSWDA)")) Q:AMHSWDA=""  S DIC=AMHSWG,Y=AMHSWDA D GETVAL,WRITE

 S AMHSWI=AMHSWI-1

 S AMHSWAN="" S:AMHSWI=1 AMHSWAN=AMHSWI

RDR I AMHSWAN="",AMHSWI R !!,"Choose: ",AMHSWAN:$S($D(DTIME):DTIME,1:300)

 I AMHSWAN,$D(AMHSWT(AMHSWAN)) S AMHLOOK=AMHSWT(AMHSWAN)

 K AMHSWV,AMHSWVA,AMHSWL,AMHSWCR,AMHSWD,AMHSWG,AMHSWDA,AMHSWI,AMHSWAN,AMHSWT,AMHSWN,AMHSWEX,AMHSWL,AMHSWP,AMHSWZ,AMHSWD2,AMHSWG2,AMHSWV2,Y

 W !

 Q

 ;

GETVAL ;

 S AMHSWD2=AMHSWD,AMHSWG2=AMHSWG,AMHSWV2=AMHSWDA

 F AMHSWL=0:0 S AMHSWVA=$P(@(AMHSWG2_AMHSWV2_",0)"),U) Q:$P(@("^DD("_AMHSWD2_",.01,0)"),U,2)'["P"  S AMHSWG2=U_$P(^(0),U,3),AMHSWD2=+$P($P(^(0),U,2),"P",2),AMHSWV2=AMHSWVA

 Q

 ;

WRITE ;

 W !,AMHSWI,"  ",AMHSWVA

 S AMHSWN=0,AMHSWT(AMHSWI)=AMHSWDA F AMHSWL=0:0 S AMHSWN=$O(@("^DD("_AMHSWD_",0,""ID"",AMHSWN)")) Q:AMHSWN=""  S AMHSWEX=^(AMHSWN) W @("$E("_DIC_"Y,0),0)") X AMHSWEX

 Q

AMHLSW    ; IHS/CMI/LAB - SWITCH TO V FILE ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 +2       ;

 +3       ; AMHLSWD=DICTIONARY NUMBER

 +4       ; AMHLSWCR=LINKING CROSS REFERENCE

 +5       ; AMHLSWV=VISIT DFN

 +6       ;

 +7        SET U="^"

 +8        SET AMHLOOK=""

 +9        IF '$DATA(AMHSWV)

               QUIT 

 +10       IF AMHSWV=""

               QUIT 

 +11       IF '$DATA(AMHSWD)

               QUIT 

 +12       IF 'AMHSWD

               QUIT 

 +13       IF '$DATA(^DIC(AMHSWD,0,"GL"))

               QUIT 

 +14       SET AMHSWG=^DIC(AMHSWD,0,"GL")

 +15       IF '$DATA(AMHSWCR)

               IF AMHSWD'=(AMHSWD\1)

                   IF AMHSWD\1=9000010

                       SET AMHSWCR="AD"

 +16       IF '$DATA(AMHSWCR)

               IF AMHSWD\1'=9000010

                   SET AMHSWCR="AC"

 +17       IF '$DATA(AMHSWCR)

               QUIT 

 +18       IF AMHSWCR=""

               QUIT 

 +19       WRITE !

 +20       SET AMHSWDA=0

           FOR AMHSWI=1:1

               SET AMHSWDA=$ORDER(@(AMHSWG_""""_AMHSWCR_""",AMHSWV,AMHSWDA)"))

               IF AMHSWDA=""

                   QUIT 

               SET DIC=AMHSWG

               SET Y=AMHSWDA

               DO GETVAL

               DO WRITE

 +21       SET AMHSWI=AMHSWI-1

 +22       SET AMHSWAN=""

           IF AMHSWI=1

               SET AMHSWAN=AMHSWI

RDR        IF AMHSWAN=""

               IF AMHSWI

                   READ !!,"Choose: ",AMHSWAN:$SELECT($DATA(DTIME):DTIME,1:300)

 +1        IF AMHSWAN

               IF $DATA(AMHSWT(AMHSWAN))

                   SET AMHLOOK=AMHSWT(AMHSWAN)

 +2        KILL AMHSWV,AMHSWVA,AMHSWL,AMHSWCR,AMHSWD,AMHSWG,AMHSWDA,AMHSWI,AMHSWAN,AMHSWT,AMHSWN,AMHSWEX,AMHSWL,AMHSWP,AMHSWZ,AMHSWD2,AMHSWG2,AMHSWV2,Y

 +3        WRITE !

 +4        QUIT 

 +5       ;

GETVAL    ;

 +1        SET AMHSWD2=AMHSWD

           SET AMHSWG2=AMHSWG

           SET AMHSWV2=AMHSWDA

 +2        FOR AMHSWL=0:0

               SET AMHSWVA=$PIECE(@(AMHSWG2_AMHSWV2_",0)"),U)

               IF $PIECE(@("^DD("_AMHSWD2_",.01,0)"),U,2)'["P"

                   QUIT 

               SET AMHSWG2=U_$PIECE(^(0),U,3)

               SET AMHSWD2=+$PIECE($PIECE(^(0),U,2),"P",2)

               SET AMHSWV2=AMHSWVA

 +3        QUIT 

 +4       ;

WRITE     ;

 +1        WRITE !,AMHSWI,"  ",AMHSWVA

 +2        SET AMHSWN=0

           SET AMHSWT(AMHSWI)=AMHSWDA

           FOR AMHSWL=0:0

               SET AMHSWN=$ORDER(@("^DD("_AMHSWD_",0,""ID"",AMHSWN)"))

               IF AMHSWN=""

                   QUIT 

               SET AMHSWEX=^(AMHSWN)

               WRITE @("$E("_DIC_"Y,0),0)")

               XECUTE AMHSWEX

 +3        QUIT