- ACHSCR1 ; COMPILED XREF FOR FILE #9002080 ; 07/25/18
- ;
- S DIKZK=2
- S DIKZ(0)=$G(^ACHSF(DA,0))
- S X=$P($G(DIKZ(0)),U,6)
- I X'="" S DH=9002080,DV=11.01,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
- S X=$P($G(DIKZ(0)),U,7)
- I X'="" S DH=9002080,DV=11.02,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
- S X=$P($G(DIKZ(0)),U,8)
- I X'="" S DH=9002080,DV=11.03,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
- S X=$P($G(DIKZ(0)),U,9)
- I X'="" S DH=9002080,DV=11.04,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
- S X=$P($G(DIKZ(0)),U,10)
- I X'="" S DH=9002080,DV=11.05,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
- S X=$P($G(DIKZ(0)),U,11)
- I X'="" S DH=9002080,DV=11.06,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
- S X=$P($G(DIKZ(0)),U,12)
- I X'="" S DH=9002080,DV=11.07,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
- S DIKZ(2)=$G(^ACHSF(DA,2))
- S X=$P($G(DIKZ(2)),U,2)
- I X'="" S DH=9002080,DV=14.02,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
- S X=$P($G(DIKZ(2)),U,3)
- I X'="" S DH=9002080,DV=14.03,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
- S X=$P($G(DIKZ(2)),U,4)
- I X'="" S DH=9002080,DV=14.04,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
- S X=$P($G(DIKZ(2)),U,5)
- I X'="" S DH=9002080,DV=14.05,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
- S X=$P($G(DIKZ(2)),U,6)
- I X'="" S DH=9002080,DV=14.06,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
- S X=$P($G(DIKZ(2)),U,7)
- I X'="" S DH=9002080,DV=14.07,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
- S X=$P($G(DIKZ(2)),U,8)
- I X'="" S DH=9002080,DV=14.08,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
- S X=$P($G(DIKZ(2)),U,9)
- I X'="" S DH=9002080,DV=14.09,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
- S X=$P($G(DIKZ(2)),U,11)
- I X'="" S DH=9002080,DV=14.11,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
- S X=$P($G(DIKZ(2)),U,12)
- I X'="" S DH=9002080,DV=14.12,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
- S X=$P($G(DIKZ(2)),U,14)
- I X'="" S DH=9002080,DV=14.14,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
- S X=$P($G(DIKZ(2)),U,15)
- I X'="" S DH=9002080,DV=14.15,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
- S X=$P($G(DIKZ(2)),U,16)
- I X'="" S DH=9002080,DV=14.16,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
- S X=$P($G(DIKZ(2)),U,17)
- I X'="" S DH=9002080,DV=14.17,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
- S X=$P($G(DIKZ(2)),U,18)
- I X'="" S DH=9002080,DV=14.18,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
- S X=$P($G(DIKZ(2)),U,19)
- I X'="" S DH=9002080,DV=14.19,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
- S X=$P($G(DIKZ(2)),U,20)
- I X'="" S DH=9002080,DV=14.2,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
- S X=$P($G(DIKZ(2)),U,21)
- I X'="" S DH=9002080,DV=14.21,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
- S X=$P($G(DIKZ(2)),U,22)
- I X'="" S DH=9002080,DV=14.22,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
- S X=$P($G(DIKZ(2)),U,23)
- I X'="" S DH=9002080,DV=14.23,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
- S X=$P($G(DIKZ(2)),U,24)
- I X'="" S DH=9002080,DV=14.24,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
- S X=$P($G(DIKZ(2)),U,25)
- I X'="" S DH=9002080,DV=14.25,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
- S X=$P($G(DIKZ(2)),U,26)
- I X'="" S DH=9002080,DV=14.26,DU=1 S DIIX=2 D:$G(DIK(0))'["A" AUDIT^DIK1
- S X=$P($G(DIKZ(0)),U,1)
- I X'="" K ^ACHSF("B",$E(X,1,30),DA)
- END G ^ACHSCR2
- ACHSCR1 ; COMPILED XREF FOR FILE #9002080 ; 07/25/18
- +1 ;
- +2 SET DIKZK=2
- +3 SET DIKZ(0)=$GET(^ACHSF(DA,0))
- +4 SET X=$PIECE($GET(DIKZ(0)),U,6)
- +5 IF X'=""
- SET DH=9002080
- SET DV=11.01
- SET DU=1
- SET DIIX=2
- IF $GET(DIK(0))'["A"
- DO AUDIT^DIK1
- +6 SET X=$PIECE($GET(DIKZ(0)),U,7)
- +7 IF X'=""
- SET DH=9002080
- SET DV=11.02
- SET DU=1
- SET DIIX=2
- IF $GET(DIK(0))'["A"
- DO AUDIT^DIK1
- +8 SET X=$PIECE($GET(DIKZ(0)),U,8)
- +9 IF X'=""
- SET DH=9002080
- SET DV=11.03
- SET DU=1
- SET DIIX=2
- IF $GET(DIK(0))'["A"
- DO AUDIT^DIK1
- +10 SET X=$PIECE($GET(DIKZ(0)),U,9)
- +11 IF X'=""
- SET DH=9002080
- SET DV=11.04
- SET DU=1
- SET DIIX=2
- IF $GET(DIK(0))'["A"
- DO AUDIT^DIK1
- +12 SET X=$PIECE($GET(DIKZ(0)),U,10)
- +13 IF X'=""
- SET DH=9002080
- SET DV=11.05
- SET DU=1
- SET DIIX=2
- IF $GET(DIK(0))'["A"
- DO AUDIT^DIK1
- +14 SET X=$PIECE($GET(DIKZ(0)),U,11)
- +15 IF X'=""
- SET DH=9002080
- SET DV=11.06
- SET DU=1
- SET DIIX=2
- IF $GET(DIK(0))'["A"
- DO AUDIT^DIK1
- +16 SET X=$PIECE($GET(DIKZ(0)),U,12)
- +17 IF X'=""
- SET DH=9002080
- SET DV=11.07
- SET DU=1
- SET DIIX=2
- IF $GET(DIK(0))'["A"
- DO AUDIT^DIK1
- +18 SET DIKZ(2)=$GET(^ACHSF(DA,2))
- +19 SET X=$PIECE($GET(DIKZ(2)),U,2)
- +20 IF X'=""
- SET DH=9002080
- SET DV=14.02
- SET DU=1
- SET DIIX=2
- IF $GET(DIK(0))'["A"
- DO AUDIT^DIK1
- +21 SET X=$PIECE($GET(DIKZ(2)),U,3)
- +22 IF X'=""
- SET DH=9002080
- SET DV=14.03
- SET DU=1
- SET DIIX=2
- IF $GET(DIK(0))'["A"
- DO AUDIT^DIK1
- +23 SET X=$PIECE($GET(DIKZ(2)),U,4)
- +24 IF X'=""
- SET DH=9002080
- SET DV=14.04
- SET DU=1
- SET DIIX=2
- IF $GET(DIK(0))'["A"
- DO AUDIT^DIK1
- +25 SET X=$PIECE($GET(DIKZ(2)),U,5)
- +26 IF X'=""
- SET DH=9002080
- SET DV=14.05
- SET DU=1
- SET DIIX=2
- IF $GET(DIK(0))'["A"
- DO AUDIT^DIK1
- +27 SET X=$PIECE($GET(DIKZ(2)),U,6)
- +28 IF X'=""
- SET DH=9002080
- SET DV=14.06
- SET DU=1
- SET DIIX=2
- IF $GET(DIK(0))'["A"
- DO AUDIT^DIK1
- +29 SET X=$PIECE($GET(DIKZ(2)),U,7)
- +30 IF X'=""
- SET DH=9002080
- SET DV=14.07
- SET DU=1
- SET DIIX=2
- IF $GET(DIK(0))'["A"
- DO AUDIT^DIK1
- +31 SET X=$PIECE($GET(DIKZ(2)),U,8)
- +32 IF X'=""
- SET DH=9002080
- SET DV=14.08
- SET DU=1
- SET DIIX=2
- IF $GET(DIK(0))'["A"
- DO AUDIT^DIK1
- +33 SET X=$PIECE($GET(DIKZ(2)),U,9)
- +34 IF X'=""
- SET DH=9002080
- SET DV=14.09
- SET DU=1
- SET DIIX=2
- IF $GET(DIK(0))'["A"
- DO AUDIT^DIK1
- +35 SET X=$PIECE($GET(DIKZ(2)),U,11)
- +36 IF X'=""
- SET DH=9002080
- SET DV=14.11
- SET DU=1
- SET DIIX=2
- IF $GET(DIK(0))'["A"
- DO AUDIT^DIK1
- +37 SET X=$PIECE($GET(DIKZ(2)),U,12)
- +38 IF X'=""
- SET DH=9002080
- SET DV=14.12
- SET DU=1
- SET DIIX=2
- IF $GET(DIK(0))'["A"
- DO AUDIT^DIK1
- +39 SET X=$PIECE($GET(DIKZ(2)),U,14)
- +40 IF X'=""
- SET DH=9002080
- SET DV=14.14
- SET DU=1
- SET DIIX=2
- IF $GET(DIK(0))'["A"
- DO AUDIT^DIK1
- +41 SET X=$PIECE($GET(DIKZ(2)),U,15)
- +42 IF X'=""
- SET DH=9002080
- SET DV=14.15
- SET DU=1
- SET DIIX=2
- IF $GET(DIK(0))'["A"
- DO AUDIT^DIK1
- +43 SET X=$PIECE($GET(DIKZ(2)),U,16)
- +44 IF X'=""
- SET DH=9002080
- SET DV=14.16
- SET DU=1
- SET DIIX=2
- IF $GET(DIK(0))'["A"
- DO AUDIT^DIK1
- +45 SET X=$PIECE($GET(DIKZ(2)),U,17)
- +46 IF X'=""
- SET DH=9002080
- SET DV=14.17
- SET DU=1
- SET DIIX=2
- IF $GET(DIK(0))'["A"
- DO AUDIT^DIK1
- +47 SET X=$PIECE($GET(DIKZ(2)),U,18)
- +48 IF X'=""
- SET DH=9002080
- SET DV=14.18
- SET DU=1
- SET DIIX=2
- IF $GET(DIK(0))'["A"
- DO AUDIT^DIK1
- +49 SET X=$PIECE($GET(DIKZ(2)),U,19)
- +50 IF X'=""
- SET DH=9002080
- SET DV=14.19
- SET DU=1
- SET DIIX=2
- IF $GET(DIK(0))'["A"
- DO AUDIT^DIK1
- +51 SET X=$PIECE($GET(DIKZ(2)),U,20)
- +52 IF X'=""
- SET DH=9002080
- SET DV=14.2
- SET DU=1
- SET DIIX=2
- IF $GET(DIK(0))'["A"
- DO AUDIT^DIK1
- +53 SET X=$PIECE($GET(DIKZ(2)),U,21)
- +54 IF X'=""
- SET DH=9002080
- SET DV=14.21
- SET DU=1
- SET DIIX=2
- IF $GET(DIK(0))'["A"
- DO AUDIT^DIK1
- +55 SET X=$PIECE($GET(DIKZ(2)),U,22)
- +56 IF X'=""
- SET DH=9002080
- SET DV=14.22
- SET DU=1
- SET DIIX=2
- IF $GET(DIK(0))'["A"
- DO AUDIT^DIK1
- +57 SET X=$PIECE($GET(DIKZ(2)),U,23)
- +58 IF X'=""
- SET DH=9002080
- SET DV=14.23
- SET DU=1
- SET DIIX=2
- IF $GET(DIK(0))'["A"
- DO AUDIT^DIK1
- +59 SET X=$PIECE($GET(DIKZ(2)),U,24)
- +60 IF X'=""
- SET DH=9002080
- SET DV=14.24
- SET DU=1
- SET DIIX=2
- IF $GET(DIK(0))'["A"
- DO AUDIT^DIK1
- +61 SET X=$PIECE($GET(DIKZ(2)),U,25)
- +62 IF X'=""
- SET DH=9002080
- SET DV=14.25
- SET DU=1
- SET DIIX=2
- IF $GET(DIK(0))'["A"
- DO AUDIT^DIK1
- +63 SET X=$PIECE($GET(DIKZ(2)),U,26)
- +64 IF X'=""
- SET DH=9002080
- SET DV=14.26
- SET DU=1
- SET DIIX=2
- IF $GET(DIK(0))'["A"
- DO AUDIT^DIK1
- +65 SET X=$PIECE($GET(DIKZ(0)),U,1)
- +66 IF X'=""
- KILL ^ACHSF("B",$EXTRACT(X,1,30),DA)
- END GOTO ^ACHSCR2
