- 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