GECSVFY0 ;WISC/RFJ-verify and check code sheet parameters ;18 Nov 93
;;2.0;GCS;;MAR 14, 1995
Q
;
;
GO ; start checking. GECSFIX will fix discrepancies if set to a 1
N GECSCS,GECSD,GECSD1,GECSDA,GECSDA1,GECSDATA,GECSDIE,GECSERR,GECSFLAG,GECSI,GECSII,GECSP
I '$D(GECSFIX) S GECSFIX=0
F GECSI=1:1 S GECSD=$T(DATA+GECSI) Q:GECSD="" S GECSD=$P(GECSD,";",3,7) I $E(GECSD)'="=" D
. D CHECK^GECSVFY1 I GECSFLAG Q
. S GECSDA=+$O(^GECS(2101.1,"B",$P(GECSD,";"),0))
. F GECSII=GECSI+1:1 S GECSDATA=$P($T(DATA+GECSII),"=",2) Q:GECSDATA="" S GECSI=GECSI+1 F GECSP=1:1 S GECSCS=$P(GECSDATA,"^",GECSP) Q:GECSCS="" D
. . S GECSDA1=+$O(^GECS(2101.2,"B",GECSCS,0))
. . S GECSD1=$G(^GECS(2101.2,GECSDA1,0))
. . I GECSD1="" W !?5,$J(GECSERR,2),". ERROR -- CODE SHEET '",GECSCS,"' IS NOT FOUND IN FILE 2101.2." Q
. . S GECSDIE=""
. . I $P(GECSD1,"^",4)'=GECSDA D
. . . W !?5,$J(GECSERR,2),". ERROR -- CODE SHEET '",GECSCS,"' BATCH SHOULD EQUAL '",$P(GECSD,";"),"'",!?35,"[NOT '",$P($G(^GECS(2101.1,+$P(GECSD1,"^",4),0)),"^"),"']" S GECSERR=GECSERR+1
. . . I GECSFIX S GECSDIE=$P(GECSD,";") W !?10,"... FIXING BATCH TYPE."
. . I $P(GECSD1,"^",5)'="Y",$P(GECSD1,"^")'="08",$P(GECSD1,"^")'="11",$P(GECSD1,"^")'="223" D
. . . W !?5,$J(GECSERR,2),". ERROR -- ACTIVE CODE SHEET ",$P(GECSD1,"^")," SHOULD BE 'YES' [NOT 'NO']" S GECSERR=GECSERR+1
. . . I GECSFIX S $P(GECSDIE,"^",2)="Y" W !?10,"... FIXING ACTIVE CODE SHEET (TO YES)."
. . ; fix code sheet if problem
. . I '$G(GECSFIX)!(GECSDIE="") Q
. . N D,D0,DA,DI,DIC,DIE,DQ,DR,X
. . S DR="" I $P(GECSDIE,"^")'="" S DR=".7///"_$P(GECSDIE,"^")_";"
. . I $P(GECSDIE,"^",2)'="" S DR=DR_"1///Y"
. . S (DIC,DIE)="^GECS(2101.2,",DA=GECSDA1 D ^DIE
Q
;
;
DATA ;;data for batch types
;;ACCOUNTS RECEIVABLE;100;AMS;Q-AMD.DOMAIN.EXT
;;=243^244^245^246^247^248^249^251^252^253^254^292^293^294^295^296^297^298
;;BUILDING MANAGEMENT;100;AMS;Q-AMD.DOMAIN.EXT
;;=217^218^219^220
;;CHAPLAIN;100;AMS;Q-AMD.DOMAIN.EXT
;;=141^142
;;CONSULTING/ATTENDING;100;CAA;Q-CAA.DOMAIN.EXT
;;=2418A^2418C^2418D1^2418D2^2418D3^2418T^C&AHDR
;;DDCSS - MENTAL HEALTH;100;DDC;Q-NPF.DOMAIN.EXT
;;=5333^5334^5335^5356^5357^53CO
;;DENTAL;100;DAS;Q-DAS.DOMAIN.EXT
;;=G61^G62^G63^G64^G65
;;DIETETICS;100;AMS;Q-AMD.DOMAIN.EXT
;;=224
;;FEE BASIS;100;AMS;Q-AMD.DOMAIN.EXT
;;=344^347^348^349^350
;;FEE BASIS - GECO;100;CNH;Q-CNH.DOMAIN.EXT
;;=18-3
;;FEE BASIS - IFCAP;49;FEN;Q-FEE.DOMAIN.EXT
;;=994.00^994.01^994.02^994.10^994.90
;;FINANCIAL MANAGEMENT;;FMS;Q-FMS.DOMAIN.EXT
;;=AO:FMS^AT:FMS^AV:FMS^BD:FMS^CO:FMS^CR:FMS^CX:FMS^DD:FMS^DV:FMS^IF:FMS^IV:FMS^MO:FMS^MV:FMS^NC:FMS^OP:FMS^PV:FMS^RC:FMS^RO:FMS^RT:FMS^RV:FMS^SA:FMS^SO:FMS^ST:FMS^SV:FMS
;;=TD:FMS^TN:FMS^TO:FMS^TP:FMS^TV:FMS^TY:FMS^TZ:FMS^VR:FMS^WR:FMS
;;FORM REQUISITION - GECO;100;FOR;Q-LOG.DOMAIN.EXT
;;=FORM1
;;HOSPITAL BASED HOME CARE- GECO;100;HBH;Q-HBH.DOMAIN.EXT
;;=HBHC3^HBHC4^HBHC5
;;LAB;25;AMS;Q-AMD.DOMAIN.EXT
;;=378^H01^H02^H03^H04^H05^H06^H07^H08^H09^H10^H11^H12^H13^H14^H15^H16^H17^H18^H19^H20^H21^H22^H23^H24^H26^H28^H29^H30^H32^H33^H34^H35^H36^H37^H38^H39^H40^H41^H42^H43^H44^H46^H47^H48^H49^H50^H51^H52^H53^H54^H55^H56^H57^H58^H59^H60
;;=H61^H62^H63^H64^H65^H66^H67^H68^H69^H73^H74^H75^H76^H77^H78^H79^H80^H81^H82^H83^H84^H85^H86^H87^H88^H89^H90^H91^H92^H93^H94^H95^H96^H97^H98^H99^J03^J07^J08^J09
;;MAS;100;AMS;Q-AMD.DOMAIN.EXT
;;=167^223^290^334^335^336^337^338^339^340^341^345^346^401^402^403^404^405^406^407^408^409^410^411^412^413^414^415^416^417^418^419^420
;;MEDICAL MEDIA;100;AMS;Q-AMD.DOMAIN.EXT
;;=165
;;MEDICINE;100;AMS;Q-AMD.DOMAIN.EXT
;;=230^234^J15^J19^J41^J42^J43^J44
;;MENTAL HEALTH;100;AMS;Q-AMD.DOMAIN.EXT
;;=169^171^172^222^229^311^312^313^314^315^316^317^318^319^324
;;NURSING;100;AMS;Q-AMD.DOMAIN.EXT
;;=200^201^202
;;PERSONNEL;100;PER;Q-PRB.DOMAIN.EXT
;;=PER1
;;PERSONNEL:VACANT;100;PER;Q-PFV.DOMAIN.EXT
;;=PER2
;;PHARMACY;100;AMS;Q-AMD.DOMAIN.EXT
;;=157^158
;;PHYSICIAN RECRUIT/STAFF - GECO;100;PHY;Q-PHY.DOMAIN.EXT
;;=PHY1^PHY2^PHY3^PHY4
;;PROSTHETICS;100;AMS;Q-AMD.DOMAIN.EXT
;;=120^121^122^123^124^125^126^127^128^129^130^131^132^133^134^135^136^137^138^139^150^173^174^362^363
;;RADIOLOGY;100;AMS;Q-AMD.DOMAIN.EXT
;;=186^189
;;RECREATION;100;AMS;Q-AMD.DOMAIN.EXT
;;=264^265
;;SECURITY/POLICE;10;AMS;Q-AMD.DOMAIN.EXT
;;=196
;;SOCIAL WORK;100;AMS;Q-AMD.DOMAIN.EXT
;;=255^256^257^258^361
;;STAFFING MANAGEMENT - GECO;100;NSY;Q-NSY.DOMAIN.EXT
;;=NSY1^NSY2^NSY3^NSY4^NSY5^NSY6^NSY7
;;SURGERY;100;AMS;Q-AMD.DOMAIN.EXT
;;=177
;;SWS (FOR VAF10-7946) - GECO;100;SWS;Q-SWS.DOMAIN.EXT
;;=7946
;;SWS - GECO;100;RCS;Q-RHC.DOMAIN.EXT
;;=18-8
;;VOLUNTARY;100;VOL;Q-NST.DOMAIN.EXT
;;=10^11^01^02^03^03R^03T^04^04D^05^08^09^10D
;;WAGE SURVEY - GECO;100;WGE;Q-WGE.DOMAIN.EXT
;;=WGE1^WGE2^WGE3^WGE4^WGE5
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGECSVFY0 4966 printed Dec 13, 2024@01:56:41 Page 2
GECSVFY0 ;WISC/RFJ-verify and check code sheet parameters ;18 Nov 93
+1 ;;2.0;GCS;;MAR 14, 1995
+2 QUIT
+3 ;
+4 ;
GO ; start checking. GECSFIX will fix discrepancies if set to a 1
+1 NEW GECSCS,GECSD,GECSD1,GECSDA,GECSDA1,GECSDATA,GECSDIE,GECSERR,GECSFLAG,GECSI,GECSII,GECSP
+2 IF '$DATA(GECSFIX)
SET GECSFIX=0
+3 FOR GECSI=1:1
SET GECSD=$TEXT(DATA+GECSI)
if GECSD=""
QUIT
SET GECSD=$PIECE(GECSD,";",3,7)
IF $EXTRACT(GECSD)'="="
Begin DoDot:1
+4 DO CHECK^GECSVFY1
IF GECSFLAG
QUIT
+5 SET GECSDA=+$ORDER(^GECS(2101.1,"B",$PIECE(GECSD,";"),0))
+6 FOR GECSII=GECSI+1:1
SET GECSDATA=$PIECE($TEXT(DATA+GECSII),"=",2)
if GECSDATA=""
QUIT
SET GECSI=GECSI+1
FOR GECSP=1:1
SET GECSCS=$PIECE(GECSDATA,"^",GECSP)
if GECSCS=""
QUIT
Begin DoDot:2
+7 SET GECSDA1=+$ORDER(^GECS(2101.2,"B",GECSCS,0))
+8 SET GECSD1=$GET(^GECS(2101.2,GECSDA1,0))
+9 IF GECSD1=""
WRITE !?5,$JUSTIFY(GECSERR,2),". ERROR -- CODE SHEET '",GECSCS,"' IS NOT FOUND IN FILE 2101.2."
QUIT
+10 SET GECSDIE=""
+11 IF $PIECE(GECSD1,"^",4)'=GECSDA
Begin DoDot:3
+12 WRITE !?5,$JUSTIFY(GECSERR,2),". ERROR -- CODE SHEET '",GECSCS,"' BATCH SHOULD EQUAL '",$PIECE(GECSD,";"),"'",!?35,"[NOT '",$PIECE($GET(^GECS(2101.1,+$PIECE(GECSD1,"^",4),0)),"^"),"']"
SET GECSERR=GECSERR+1
+13 IF GECSFIX
SET GECSDIE=$PIECE(GECSD,";")
WRITE !?10,"... FIXING BATCH TYPE."
End DoDot:3
+14 IF $PIECE(GECSD1,"^",5)'="Y"
IF $PIECE(GECSD1,"^")'="08"
IF $PIECE(GECSD1,"^")'="11"
IF $PIECE(GECSD1,"^")'="223"
Begin DoDot:3
+15 WRITE !?5,$JUSTIFY(GECSERR,2),". ERROR -- ACTIVE CODE SHEET ",$PIECE(GECSD1,"^")," SHOULD BE 'YES' [NOT 'NO']"
SET GECSERR=GECSERR+1
+16 IF GECSFIX
SET $PIECE(GECSDIE,"^",2)="Y"
WRITE !?10,"... FIXING ACTIVE CODE SHEET (TO YES)."
End DoDot:3
+17 ; fix code sheet if problem
+18 IF '$GET(GECSFIX)!(GECSDIE="")
QUIT
+19 NEW D,D0,DA,DI,DIC,DIE,DQ,DR,X
+20 SET DR=""
IF $PIECE(GECSDIE,"^")'=""
SET DR=".7///"_$PIECE(GECSDIE,"^")_";"
+21 IF $PIECE(GECSDIE,"^",2)'=""
SET DR=DR_"1///Y"
+22 SET (DIC,DIE)="^GECS(2101.2,"
SET DA=GECSDA1
DO ^DIE
End DoDot:2
End DoDot:1
+23 QUIT
+24 ;
+25 ;
DATA ;;data for batch types
+1 ;;ACCOUNTS RECEIVABLE;100;AMS;Q-AMD.DOMAIN.EXT
+2 ;;=243^244^245^246^247^248^249^251^252^253^254^292^293^294^295^296^297^298
+3 ;;BUILDING MANAGEMENT;100;AMS;Q-AMD.DOMAIN.EXT
+4 ;;=217^218^219^220
+5 ;;CHAPLAIN;100;AMS;Q-AMD.DOMAIN.EXT
+6 ;;=141^142
+7 ;;CONSULTING/ATTENDING;100;CAA;Q-CAA.DOMAIN.EXT
+8 ;;=2418A^2418C^2418D1^2418D2^2418D3^2418T^C&AHDR
+9 ;;DDCSS - MENTAL HEALTH;100;DDC;Q-NPF.DOMAIN.EXT
+10 ;;=5333^5334^5335^5356^5357^53CO
+11 ;;DENTAL;100;DAS;Q-DAS.DOMAIN.EXT
+12 ;;=G61^G62^G63^G64^G65
+13 ;;DIETETICS;100;AMS;Q-AMD.DOMAIN.EXT
+14 ;;=224
+15 ;;FEE BASIS;100;AMS;Q-AMD.DOMAIN.EXT
+16 ;;=344^347^348^349^350
+17 ;;FEE BASIS - GECO;100;CNH;Q-CNH.DOMAIN.EXT
+18 ;;=18-3
+19 ;;FEE BASIS - IFCAP;49;FEN;Q-FEE.DOMAIN.EXT
+20 ;;=994.00^994.01^994.02^994.10^994.90
+21 ;;FINANCIAL MANAGEMENT;;FMS;Q-FMS.DOMAIN.EXT
+22 ;;=AO:FMS^AT:FMS^AV:FMS^BD:FMS^CO:FMS^CR:FMS^CX:FMS^DD:FMS^DV:FMS^IF:FMS^IV:FMS^MO:FMS^MV:FMS^NC:FMS^OP:FMS^PV:FMS^RC:FMS^RO:FMS^RT:FMS^RV:FMS^SA:FMS^SO:FMS^ST:FMS^SV:FMS
+23 ;;=TD:FMS^TN:FMS^TO:FMS^TP:FMS^TV:FMS^TY:FMS^TZ:FMS^VR:FMS^WR:FMS
+24 ;;FORM REQUISITION - GECO;100;FOR;Q-LOG.DOMAIN.EXT
+25 ;;=FORM1
+26 ;;HOSPITAL BASED HOME CARE- GECO;100;HBH;Q-HBH.DOMAIN.EXT
+27 ;;=HBHC3^HBHC4^HBHC5
+28 ;;LAB;25;AMS;Q-AMD.DOMAIN.EXT
+29 ;;=378^H01^H02^H03^H04^H05^H06^H07^H08^H09^H10^H11^H12^H13^H14^H15^H16^H17^H18^H19^H20^H21^H22^H23^H24^H26^H28^H29^H30^H32^H33^H34^H35^H36^H37^H38^H39^H40^H41^H42^H43^H44^H46^H47^H48^H49^H50^H51^H52^H53^H54^H55^H56^H57^H58^H59^H60
+30 ;;=H61^H62^H63^H64^H65^H66^H67^H68^H69^H73^H74^H75^H76^H77^H78^H79^H80^H81^H82^H83^H84^H85^H86^H87^H88^H89^H90^H91^H92^H93^H94^H95^H96^H97^H98^H99^J03^J07^J08^J09
+31 ;;MAS;100;AMS;Q-AMD.DOMAIN.EXT
+32 ;;=167^223^290^334^335^336^337^338^339^340^341^345^346^401^402^403^404^405^406^407^408^409^410^411^412^413^414^415^416^417^418^419^420
+33 ;;MEDICAL MEDIA;100;AMS;Q-AMD.DOMAIN.EXT
+34 ;;=165
+35 ;;MEDICINE;100;AMS;Q-AMD.DOMAIN.EXT
+36 ;;=230^234^J15^J19^J41^J42^J43^J44
+37 ;;MENTAL HEALTH;100;AMS;Q-AMD.DOMAIN.EXT
+38 ;;=169^171^172^222^229^311^312^313^314^315^316^317^318^319^324
+39 ;;NURSING;100;AMS;Q-AMD.DOMAIN.EXT
+40 ;;=200^201^202
+41 ;;PERSONNEL;100;PER;Q-PRB.DOMAIN.EXT
+42 ;;=PER1
+43 ;;PERSONNEL:VACANT;100;PER;Q-PFV.DOMAIN.EXT
+44 ;;=PER2
+45 ;;PHARMACY;100;AMS;Q-AMD.DOMAIN.EXT
+46 ;;=157^158
+47 ;;PHYSICIAN RECRUIT/STAFF - GECO;100;PHY;Q-PHY.DOMAIN.EXT
+48 ;;=PHY1^PHY2^PHY3^PHY4
+49 ;;PROSTHETICS;100;AMS;Q-AMD.DOMAIN.EXT
+50 ;;=120^121^122^123^124^125^126^127^128^129^130^131^132^133^134^135^136^137^138^139^150^173^174^362^363
+51 ;;RADIOLOGY;100;AMS;Q-AMD.DOMAIN.EXT
+52 ;;=186^189
+53 ;;RECREATION;100;AMS;Q-AMD.DOMAIN.EXT
+54 ;;=264^265
+55 ;;SECURITY/POLICE;10;AMS;Q-AMD.DOMAIN.EXT
+56 ;;=196
+57 ;;SOCIAL WORK;100;AMS;Q-AMD.DOMAIN.EXT
+58 ;;=255^256^257^258^361
+59 ;;STAFFING MANAGEMENT - GECO;100;NSY;Q-NSY.DOMAIN.EXT
+60 ;;=NSY1^NSY2^NSY3^NSY4^NSY5^NSY6^NSY7
+61 ;;SURGERY;100;AMS;Q-AMD.DOMAIN.EXT
+62 ;;=177
+63 ;;SWS (FOR VAF10-7946) - GECO;100;SWS;Q-SWS.DOMAIN.EXT
+64 ;;=7946
+65 ;;SWS - GECO;100;RCS;Q-RHC.DOMAIN.EXT
+66 ;;=18-8
+67 ;;VOLUNTARY;100;VOL;Q-NST.DOMAIN.EXT
+68 ;;=10^11^01^02^03^03R^03T^04^04D^05^08^09^10D
+69 ;;WAGE SURVEY - GECO;100;WGE;Q-WGE.DOMAIN.EXT
+70 ;;=WGE1^WGE2^WGE3^WGE4^WGE5
